package Util;
use File::Listing;
use TRFLP;
use File::stat;
use Time::localtime;
use Net::FTP;

sub print_revision {
  my ($rev) = @_;
  return "<p style=\"color: #999; margin-top: 1em;\"><em>$rev</em></p>";
}

sub source {
  my ($rev) = @_;
  my $source = 'Util::source => unknown';
  if ( $rev =~ /Header:.+stat\/(interface\/)?([^,]+),v/ ) {
    $source = $2;
  } elsif ( $rev =~ /Id: ([^,]+),v/ ) {
    $source = $1;
  }
  return $source;
}

sub version {
  my ($rev) = @_;
  my $version = '';
  if ($rev =~ /(,v(.+)) \d\d?:\d\d?/) {
    $version = "v.$2";
  }
  return $version;
}

sub list_remote {
  my ($url) = @_;

  my $ua = LWP::UserAgent->new;
  $ua->agent("Ken's Peak Calling Robot/0.1 ");

  # Create a request
  my $req = HTTP::Request->new(GET => $url);
  $req->header(Accept => "text/plain, */*;q=0.1");

  # Pass request to the user agent and get a response back
  my $res = $ua->request($req);

  # Check the outcome of the response
  my @dir;
  if ($res->is_success) {
    for ( parse_dir($res->content) ) {
      my ($name, $type, $size, $mtime, $mode) = @$_;
      push @dir, [$mtime, $name];
    }
    return @dir;
  }
  else {
    die $res->status_line;
  }
}

sub list_remote_dir {
  my ($dir) = @_;

  # return ("ERROR: pass");
  my $ua = Net::FTP->new($TRFLP::dnacore_server, Passive => 1, Debug => 0)
    or return ("ERROR: Cannot connect to $TRFLP::dnacore_server: $@");

  $ua->login($TRFLP::dnacore_user, $TRFLP::dnacore_password)
    or return ("ERROR: Cannot login to $TRFLP::dnacore_server: " . $ua->message);

  $ua->cwd("$TRFLP::dnacore_dir/$dir")
    or return ("ERROR: Cannot chdir to $TRFLP::dnacore_dir/$dir: " . $ua->message);

  my @listing = $ua->dir()
    or return ("ERROR: Cannot run 'dir' in $TRFLP::dnacore_server/$TRFLP::dnacore_dir/$dir: " . $ua->message);

  # Check the outcome of the response
  my @dir;
  for ( parse_dir(\@listing) ) {
    my ($name, $type, $size, $mtime, $mode) = @$_;
    push @dir, [$mtime, $name];
  }
  return @dir;
}

sub list_remote_dirs {
  # this function differs from the above in that it ignores everything except directories
  my ($url) = @_;

  # return ("ERROR: pass");
  my $ua = Net::FTP->new($TRFLP::dnacore_server, Passive => 1, Debug => 0)
    or return ("ERROR: Cannot connect to $TRFLP::dnacore_server: $@");

  $ua->login($TRFLP::dnacore_user, $TRFLP::dnacore_password)
    or return ("ERROR: Cannot login to $TRFLP::dnacore_server: " . $ua->message);

  $ua->cwd($TRFLP::dnacore_dir)
    or return ("ERROR: Cannot chdir to $TRFLP::dnacore_dir: " . $ua->message);

  my @listing = $ua->dir()
    or return ("ERROR: Cannot run 'dir' in $TRFLP::dnacore_server/$TRFLP::dnacore_dir: " . $ua->message);

  my @dir;
  for ( parse_dir(\@listing) ) {
    my ($name, $type, $size, $mtime, $mode) = @$_;
    next if $type ne 'd';
    push @dir, [$mtime, $name];
  }
  return @dir;
}

sub list_remote_dirs_with_lwp {
  # this function differs from the above in that it ignores everything except directories
  my ($url) = @_;

  my $ua = LWP::UserAgent->new;
  $ua->agent("Ken's Peak Calling Robot/0.1 ");

  # Create a request
  my $req = HTTP::Request->new(GET => $url);
  $req->header(Accept => "text/plain, */*;q=0.1");

  # Pass request to the user agent and get a response back
  my $res = $ua->request($req);

  # Check the outcome of the response
  my @dir;
  if ($res->is_success) {
    print STDERR "success...\n";
    use Data::Dumper;
    print Dumper($res->content);
    for ( parse_dir($res->content) ) {
      my ($name, $type, $size, $mtime, $mode) = @$_;
      print STDERR "reading remote: $name\n";
      push @dir, [$mtime, $name];
      next if $type ne 'd';
    }
    return @dir;
  }
  else {
    return "ERROR: " . $res->status_line;
  }
}

sub list_local_dirs {
  my @dir;
  opendir(my $dh, $TRFLP::data_path) || die "can't open $TRFLP::data_path: $!";
  foreach my $name ( readdir($dh) ) {
    next if $name eq '.' or $name eq '..';
    next unless -d "$TRFLP::data_path/$name";
    my $date = Time::localtime::ctime(File::stat::stat("$TRFLP::data_path/$name")->mtime);
    push @dir, [$date, $name];
  }
  closedir $dh;
  return @dir;
}


sub stage1 {
  chomp(@_);
  my @suff = map {(split /\./)[-1]} @_;
  my %stage = (
	       fsa => 1,
	       sample => 1,
	       standard => 1,
	       clipped => 2,
               target => 3,
	       warped => 4,
	       peak => 5,
	       deriv => 5,
	      );
  return (sort @stage{@suff})[-1];
}

sub stage2 {
  chomp(@_);
  my @suff = map {(split /\./)[-1]} @_;
  my %stage = (
	       fsa => 1,
	       sample => 1,
	       standard => 1,
	       hist => 2,
	       warped => 3,
	      );
  return (sort @stage{@suff})[-1];
}

sub open_cgi_shell {
  my ($title) = @_;
  # my $this_loc = "http://cci.uchicago.edu/~selkovjr/trflp";
  my $this_loc = "/";
  print <<END
Content-type: multipart/x-mixed-replace;boundary=NEXT

--NEXT
Content-type: text/html

<html>
  <head>
    <title>$title</title>
  </head>
  <body onLoad="top.opener.location.href='$this_loc'">

    <h2>$title</h2>

    <table cellpadding="5">
      <tr>
        <td valign="center"><h1><font color="brown">!</font></h1></td>
        <td valign="top">
          Pushing your browser's stop button will cancel this
          job, possibly leaving debris in your project directory on
          the server. Avoid stopping the browser while the job is
          running, even if the browser indicates the transaction as
          "stalled". Some tasks may take a long time to complete.
          It may also be a good idea to check the timeout value in
          your browser settings. It must not be smaller than the expected
          job completion time.
        </td>
      </tr>
    </table>

    <p>
      <em>Starting ...</em>
    </p>

    <pre style="color: #edb; background-color: #333">
END
;
  Util::run_task(*STDOUT, "date");
  print "\n";
}

sub close_cgi_shell {
  Util::run_task(*STDOUT, "date");
  print q(    </pre>

    <p>
      <em>Finished. Give the parent window a few seconds to update...</em>
    </p>
  </body>
</html>
--NEXT--
);
}


sub run_task {
  my ($FH, $cmd, $silent) = @_;
  my $pid = open PIPE, "-|";
  if ( $pid ) { # I'm the parent
    select(STDERR); $| = 1;         # make unbuffered
    select(STDOUT); $| = 1;         # make unbuffered
    my($stat, $data);
    while ($stat = sysread PIPE, $data, 1024) {
      print $FH "$data";
    }
    die "sysread error: $!" unless defined $stat;
    close PIPE;
  }
  else { # I'm the child
    if ( $silent ) {
      exec qq(echo ""; $cmd 2>\&1);
    }
    else {
      exec qq(echo ""; echo "\<b\>&gt; $cmd\</b\>"; $cmd 2>\&1);
    }
    die "error running '$cmd': $!"; # if you get here
  }
}

sub is_abif {
  my ($abi) = @_;
  return substr($abi, 0, 4) eq 'ABIF';
}

sub parse_abif {
  my ($abi) = @_;
  die "don't know what to do with this file; expecting ABIF" if substr($abi, 0, 4) ne 'ABIF';

  my %aflp;
  my @param;
  my @size;
  my $gelname;
  my $gellane;
  my $numdye;
  my @dyepeak;
  my $numlane;

  my $indexadd=unpack "N",substr($abi,26,4);
  my $indexlen=unpack "N",substr($abi,18,4);

  # typedef struct {
  #   char[4]     tag,
  #   long        tag_number,  /* for multiple tag entries */
  #   short       data_type,   /*
  #                                2 = simple array of ASCII chars
  #                                4 = integer
  #                                5 = long ?
  #                                7 = float
  #                               10 = mm/dd/yy
  #                               11 = hh/mm/ss
  #                               18 = pString
  #                               19 = c-string? (null-terminated)
  #                             1024 =
  #                             */
  #   short       element_length,      /* referenced data element length in bytes <- $elemlen
  #   long        number_of_elements,  /* number of referenced data elements */   <- $numelem
  #   long        record_length,       /* legth of the refernced data array */    <- $totlen
  #   long        data_record,         /* the data, if record_length 4 bytes or less, else offset to data from file start */
  # }

  my %type = (
	      2 => "ascii",
	      4 => "integer",
	      5 => "long",
	      7 => "float",
	      10 => "date",
	      11 => "time",
	      18 => "pstring",
	      19 => "asciiz",
	      1024 => "TYPE 1024",
	     );

  my @sample;
  my @standard;
  for my $i ( 0 .. $indexlen-1) {
    my $offset = $i*28 + $indexadd;
    my ($tag, $tagnumber, $datatype, $elemlen, $numelem, $totlen) = unpack "a4NnnNNN", substr($abi, $offset, 20);
    #  print "($tag, $tagnumber, $datatype, $elemlen, $numelem, $totlen)\n";

    my $data_offset = $totlen > 4 ? unpack("N", substr($abi, $offset+20, 4)) : $offset+20;

    if ( $tag =~ /data/i and $datatype == 4 ) {
      my $data = substr($abi, $data_offset, $totlen);
      my @buf = unpack "C" x (2*$numelem), $data;
      foreach my $i ( 0 .. @buf/2 - 1 ) {
	# swap bytes
	my ( $high, $low ) = ($buf[2*$i], $buf[2*$i+1]);
	#      print "$i -> ( $high, $low )\n";
	if ( $tagnumber == 1 ) {
	  push @sample, unpack("s", pack( "CC", $low, $high ));
	}
	if ( $tagnumber == 4 ) {
	  push @standard, unpack("s", pack( "CC", $low, $high ));
	}
      }
    } # endif data
  } # endfor
  return (\@sample, \@standard);
}

1;
